home *** CD-ROM | disk | FTP | other *** search
- #include "config.h"
- #include "lisp.h"
- #include "termchar.h"
- #include "dispextern.h"
- #include "termhooks.h"
- #include "frame.h"
-
- #include <stdio.h>
- #include <string.h>
- #include <stddef.h>
- #include <sys/time.h>
- #include <internal/devices.h>
- #include <internal/vars.h>
-
- #define min(x,y) ((x) > (y) ? (y) : (x))
- #define max(x,y) ((x) < (y) ? (y) : (x))
-
- #undef LONGBITS
-
- #include <exec/types.h>
- #include <exec/interrupts.h>
- #include <devices/input.h>
- #include <devices/inputevent.h>
- #include <intuition/intuitionbase.h>
- #include <intuition/intuition.h>
- #include <devices/conunit.h>
- #include <devices/inputevent.h>
- #include <graphics/gfxbase.h>
- #include <graphics/gfxmacros.h>
- #include <utility/hooks.h>
- #include <workbench/startup.h>
- #include <workbench/workbench.h>
- #include <libraries/asl.h>
-
- #include <proto/exec.h>
- #include <proto/dos.h>
- #include <proto/intuition.h>
- #include <proto/graphics.h>
- #include <proto/console.h>
- #include <proto/diskfont.h>
- #include <proto/wb.h>
- #include <proto/asl.h>
-
- /* this is defined for those unlucky enough
- * not to have the 3.0 headers -ch3/16/93. */
- #ifndef WA_NewLookMenus
- #define WA_NewLookMenus (WA_Dummy + 0x30)
- #endif
-
- #include "amiga.h"
-
- #ifdef USE_PROTOS
- #include "protos.h"
- #endif
-
- /* CHFIXME: amiga.h */
- extern int map_menu_selection(int menu_num, int item_num, int subitem_num, Lisp_Object *subprefixes);
-
- #define SHIFT_MASK (IEQUALIFIER_LSHIFT | IEQUALIFIER_RSHIFT)
- #define CONTROL_MASK IEQUALIFIER_CONTROL
- /* CHFIXME: check other usages of META_MASK for need of NO_SNAP_MASK */
- #define META_MASK (IEQUALIFIER_LALT)
- /* CHFIXME: need input from others if using
- * IEQUALIFIER_RELATIVEMOUSE make something fail
- * IEQUALIFIER_RELATIVEMOUSE is set on normal typing but not
- * when snapped characters are inserted (e.g. via snap or powersnap)
- * these snappers use LALT as qualifier but don\'t want it to mean
- * META
- */
- #define NO_SNAP_MASK (IEQUALIFIER_RELATIVEMOUSE)
-
- struct GfxBase *GfxBase;
- struct IntuitionBase *IntuitionBase;
- struct Library *DiskfontBase, *KeymapBase, *WorkbenchBase;
-
- static char intkey_code, intkey_qualifier;
- static struct IOStdReq *input_req;
- static struct Interrupt int_handler_hook;
- static int hooked;
-
- static struct MsgPort *wbport;
- static struct AppWindow *emacs_app_win;
- static struct AppIcon *emacs_icon;
-
- struct Library *ConsoleDevice;
- static struct TextFont *font;
- static int font_opened;
- /* The reset string resets the console, turns off scrolling and sets up
- the foreground & background colors. */
- #define CONSOLE_RESET "\x1b""c\x9b>1l\x9b""3%d;4%d;>%dm"
- static char reset_string[20]; /* Must be big enough for
- printf(CONSOLE_RESET, foreground, background, background);
- (0 <= foreground, background <= 7) */
-
- /* These are the pen numbers for emacs window's base colors */
- int foreground = 1, background = 0;
-
- /* Current window, and its main characteristics */
- #if 0
- struct Window *EMACS_WIN(f);
- #endif
- WORD emacs_x = 0, emacs_y = 0, emacs_w = 640, emacs_h = 200;
- char *emacs_screen_name;
- /* a storage area for the name of the screen last opened on */
- char emacs_screen_name_storage[MAXPUBSCREENNAME+1];
- int emacs_backdrop = 0; /* Use backdrop window ? */
-
- /* Current window size: */
- #define EMACS_X(f) (EMACS_WIN(f) ? EMACS_WIN(f)->LeftEdge : emacs_x)
- #define EMACS_Y(f) (EMACS_WIN(f) ? EMACS_WIN(f)->TopEdge : emacs_y)
- #define EMACS_W(f) (EMACS_WIN(f) ? EMACS_WIN(f)->Width : emacs_w)
- #define EMACS_H(f) (EMACS_WIN(f) ? EMACS_WIN(f)->Height : emacs_h)
-
- /* used for setting the color of standout text -ch3/16/93. */
- int inverse_fill_pen = 8, inverse_text_pen = 8;
-
- /* IO request for all console io. */
- #ifndef MULTI_FRAME
- static struct IOStdReq *emacs_console;
- #else
- you lose
- #endif
-
- #define emacs_icon_width 57
- #define emacs_icon_height 55
- #define emacs_icon_num_planes 1
- #define emacs_icon_words_per_plane 220
-
- UWORD chip emacs_icon_data[1][55][4] = {
- {
- 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
- 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
- 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0fe0,0x6000,
- 0x0000,0x0000,0x0060,0x6000,0x0000,0x0000,0x0fff,0xe000,
- 0x0000,0x0000,0x1800,0x2000,0x0000,0x0000,0x13ff,0xa000,
- 0x0000,0x0000,0x1400,0xa000,0x0000,0x0000,0x3600,0xa000,
- 0x0000,0x0000,0x0000,0xa000,0x0000,0x0000,0x0c00,0xa000,
- 0x0000,0x0000,0x1e00,0xa000,0x0000,0x0000,0x0c00,0xa000,
- 0x0000,0x0000,0x0000,0xa000,0x0000,0x0000,0x2100,0xa000,
- 0x0000,0x0000,0x3300,0xa000,0x0000,0x0000,0x0c00,0xa000,
- 0x003f,0xffff,0xffff,0xb000,0x001f,0xffff,0xffff,0x8000,
- 0x004e,0x0000,0x0001,0xf000,0x00c6,0x00f0,0x0001,0x8000,
- 0x00c6,0x0100,0x0001,0x8000,0x0006,0x0103,0x9201,0x8000,
- 0x0006,0x013a,0x5201,0x8000,0x00c6,0x010a,0x5201,0x8000,
- 0x00c6,0x010a,0x5601,0x8000,0x0086,0x00f2,0x4a01,0x8000,
- 0x0006,0x0000,0x0001,0x8000,0x0046,0x0000,0x0001,0x8000,
- 0x00c6,0x7c00,0x0001,0x8000,0x00c6,0x4000,0x0001,0x8000,
- 0x0006,0x41d8,0xc319,0x8000,0x0006,0x7925,0x24a1,0x8000,
- 0x00c6,0x4125,0x2419,0x8000,0x01c6,0x4125,0x2485,0x8000,
- 0x0086,0x7d24,0xd319,0x8000,0x0007,0x0000,0x0003,0x8000,
- 0x0003,0xffe3,0xffff,0x0000,0x0081,0xfff7,0xfffe,0x0000,
- 0x01c0,0x0036,0x0000,0x0000,0x0180,0x0014,0x0f80,0x0000,
- 0x0000,0x0014,0x1040,0x0000,0x0000,0x0014,0x2720,0x0000,
- 0x0000,0x0012,0x28a0,0x0000,0x0080,0x000a,0x48a0,0x0000,
- 0x01c0,0x0009,0x90a0,0x0000,0x0180,0x0004,0x20a0,0x0000,
- 0x0000,0x0003,0xc0a0,0x0000,0x0000,0x0000,0x00a0,0x0000,
- 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
- 0x0000,0x0000,0x0000,0x0000
- },
- };
-
- struct Image far emacs_icon_image = {
- 0, 0,
- emacs_icon_width, emacs_icon_height, emacs_icon_num_planes,
- (UWORD *)emacs_icon_data,
- 3, 0,
- 0
- };
-
- static struct DiskObject far emacs_icon_object = {
- 0, 0,
- { 0, 0, 0, emacs_icon_width, emacs_icon_height, 0, 0, 0, (APTR)&emacs_icon_image },
- 0, 0, 0,
- NO_ICON_POSITION, NO_ICON_POSITION
- };
-
- static struct Hook background_hook;
-
- #define TRY_NEW_MOUSE /* CHFIXME */
-
- #define EVENTSIZE 32
-
- static struct event {
- ULONG class;
- UWORD code, qual;
- WORD x, y;
- } events[EVENTSIZE];
- static int event_num, event_in, event_out;
-
- static struct wbevent {
- struct wbevent *next;
- char file[1];
- } *wbevents;
-
- Lisp_Object Vamiga_mouse_pos;
- Lisp_Object Vamiga_mouse_item;
- extern Lisp_Object MouseMap;
- int amiga_remap_bsdel;
- int amiga_remap_numeric_keypad;
- int amiga_mouse_initialized;
- int amiga_wb_initialized;
- int emacs_iconified;
- static int mouse_event; /* set if mouse_event happened */
-
- int
- mouse_event_pending()
- {
- return mouse_event>0;
- }
- void
- reset_mouse_event_pending()
- {
- mouse_event = 0;
- }
-
- void
- set_mouse_event_pending()
- {
- mouse_event = 1;
- }
-
- static int amiga_pos_x(FRAME_PTR f, int x)
- {
- return (x - EMACS_WIN(f)->BorderLeft) / EMACS_WIN(f)->RPort->Font->tf_XSize;
- }
-
- static int amiga_pos_y(FRAME_PTR f, int y)
- {
- return (y - EMACS_WIN(f)->BorderTop) / EMACS_WIN(f)->RPort->Font->tf_YSize;
- }
-
- void
- glyph_to_pixel_coords(FRAME_PTR f, int col, int row, int *pixcol, int *pixrow)
- {
- *pixcol = (col * EMACS_WIN(f)->RPort->Font->tf_XSize) + EMACS_WIN(f)->BorderLeft;
- *pixrow = (row * EMACS_WIN(f)->RPort->Font->tf_YSize) + EMACS_WIN(f)->BorderTop;
- }
-
- /* Given a pixel position (PIX_X, PIX_Y) on the frame F, return
- glyph co-ordinates in (*X, *Y). Set *BOUNDS to the rectangle
- that the glyph at X, Y occupies, if BOUNDS != 0.
- If NOCLIP is nonzero, do not force the value into range. */
-
- void
- pixel_to_glyph_coords(FRAME_PTR f, int pixcol, int pixrow, int *col, int *row,
- void *bounds, int noclip)
- {
- int acol, arow;
-
- /* Arrange for the division in amiga_pos_x etc. to round down
- even for negative valuse. */
- if(pixcol < 0)
- pixcol -= EMACS_WIN(f)->RPort->Font->tf_XSize -1; /* CHFIXME: use FONT_WIDTH */
- if(pixrow < 0)
- pixrow -= EMACS_WIN(f)->RPort->Font->tf_YSize -1; /* CHFIXME: use FONT_HEIGH */
- acol = amiga_pos_x(f, pixcol);
- arow = amiga_pos_y(f, pixrow);
- /* no bounds if not MULTI_FRAME */
- if(!noclip)
- {
- if(acol < 0) acol = 0;
- if(arow < 0) arow = 0;
- if(acol > FRAME_WIDTH(f)) acol = FRAME_WIDTH(f);
- if(arow > FRAME_HEIGHT(f)) arow = FRAME_HEIGHT(f);
- }
- *col = acol;
- *row = arow;
- }
-
- extern int waiting_for_input; /* CHFIXME */
- extern int frame_garbaged;
-
- static void amiga_change_size(FRAME_PTR f)
- {
- int new_height = amiga_pos_y(f, EMACS_WIN(f)->Height - EMACS_WIN(f)->BorderBottom);
- int new_width = amiga_pos_x(f, EMACS_WIN(f)->Width - EMACS_WIN(f)->BorderRight);
-
- /* Is this true for Emacs 19.25?
- I consider that refreshes are possible during a select, which is
- true for the current state of emacs */
- change_frame_size(selected_frame, new_height, new_width, 0,
- !selecting && !waiting_for_input);
-
- /* Force redisplay */
- SET_FRAME_GARBAGED(selected_frame);
- }
-
- /* Get terminal size from system.
- Store number of lines into *heightp and width into *widthp.
- If zero is stored, the value is not valid. */
-
- void amiga_get_window_size (FRAME_PTR f, int *widthp, int *heightp)
- {
- if (EMACS_WIN(f))
- {
- *heightp = amiga_pos_y(f, EMACS_WIN(f)->Height - EMACS_WIN(f)->BorderBottom);
- *widthp = amiga_pos_x(f, EMACS_WIN(f)->Width - EMACS_WIN(f)->BorderRight);
- }
- else
- {
- *heightp = 0;
- *widthp = 0;
- }
- }
-
- static int set_min_size(struct Window *win, struct TextFont *font,
- WORD *minw, WORD *minh)
- {
- *minw = 11 * font->tf_XSize + win->BorderLeft + win->BorderRight;
- *minh = 4 * font->tf_YSize + win->BorderTop + win->BorderBottom;
-
- return (int)WindowLimits(win, *minw, *minh, 0, 0);
- }
-
- struct fill
- {
- struct Layer *layer;
- struct Rectangle bounds;
- WORD offsetx, offsety;
- };
-
- /* __interrupt disables stack checking. -ch3/19/93. */
- static ULONG __asm __saveds __interrupt
- fill_background(register __a2 struct RastPort *obj,
- register __a1 struct fill *msg)
- {
- struct Layer *l;
-
- SetAPen(obj, background);
- SetDrMd(obj, JAM1);
- SetAfPt(obj, 0, 0);
- SetWrMsk(obj, 0xff);
- /* Gross hack starts here */
- l = obj->Layer;
- obj->Layer = 0;
- /* Stops */
- RectFill(obj, msg->bounds.MinX, msg->bounds.MinY,
- msg->bounds.MaxX, msg->bounds.MaxY);
- /* Starts again */
- obj->Layer = l;
- /* And finally dies */
-
- return 0;
- }
-
- static void clear_window(FRAME_PTR f)
- {
- SetAPen(EMACS_WIN(f)->RPort, background);
- RectFill(EMACS_WIN(f)->RPort, EMACS_WIN(f)->BorderLeft, EMACS_WIN(f)->BorderTop,
- EMACS_WIN(f)->Width - EMACS_WIN(f)->BorderRight - 1,
- EMACS_WIN(f)->Height - EMACS_WIN(f)->BorderBottom - 1);
- }
-
- static int make_reset_string(void)
- {
- sprintf(reset_string, CONSOLE_RESET, foreground, background, background);
- }
-
- void reset_window(FRAME_PTR f)
- {
- make_reset_string();
- if (EMACS_WIN(f))
- {
- screen_puts (f, reset_string, strlen(reset_string));
- clear_window(f);
- amiga_change_size (f);
- }
- }
-
- static void close_app_win(void)
- {
- if (emacs_app_win)
- {
- struct AppMessage *msg;
-
- RemoveAppWindow(emacs_app_win); /* What can I do if it fails ?! */
- while (msg = (struct AppMessage *)GetMsg(wbport)) ReplyMsg(msg);
- }
- }
-
- #ifdef MULTI_FRAME
- you lose!
- #endif
-
- static int close_emacs_window(FRAME_PTR f)
- {
- close_app_win();
- inputsig &= ~(1L << EMACS_WIN(f)->UserPort->mp_SigBit);
- _device_close(emacs_console);
- if(EMACS_WIN(f))
- {
- /* put title back the way it should be -ch3/19/93. */
- ShowTitle(EMACS_WIN(f)->WScreen, !emacs_backdrop);
- }
- CloseWindow(EMACS_WIN(f));
- emacs_console = 0;
- EMACS_WIN(f) = 0;
- ConsoleDevice = 0;
- }
-
- /* We need this function because we do not always have the string
- * for the screen we opened on. for example LockPubScreen(NULL);
- * This function will get the name by looping through all public
- * screens looking for the one that matches ours. -ch3/20/93 */
-
- char *get_screen_name(struct Screen *this, char *namebuf)
- {
- struct PubScreenNode *pubscreens =
- (struct PubScreenNode *)LockPubScreenList()->lh_Head;
-
- while (pubscreens->psn_Node.ln_Succ)
- {
- if (pubscreens->psn_Screen == this)
- {
- strcpy(namebuf, pubscreens->psn_Node.ln_Name);
- UnlockPubScreenList();
- return namebuf;
- }
- pubscreens = (struct PubScreenNode *)pubscreens->psn_Node.ln_Succ;
- }
- /* Failed to find screen */
- namebuf[0] = '\0';
- UnlockPubScreenList();
-
- return 0;
- }
-
- enum open_emacs_win_ret { ok, no_screen, no_window };
-
- /* added two parameters to eliminate the need for the global
- * which was causing some unwanted effect (bugs). -ch3/19/93 */
-
- static enum open_emacs_win_ret
- open_emacs_window(FRAME_PTR f, UWORD x, UWORD y, UWORD w, UWORD h, int backdrop,
- char *pubscreen_name)
- /* Open or reopen emacs window */
- {
- WORD minw, minh;
- struct Screen *new_screen;
- struct Window *new_win;
- struct IOStdReq *new_console;
- int no_backdrop = !backdrop;
-
- new_screen = LockPubScreen(pubscreen_name);
-
- if (!new_screen)
- return no_screen;
-
- /* removed newwindow structure, and added as tag
- * items so that we can change them easier. -ch3/16/93. */
-
- new_win = OpenWindowTags(0, WA_Left, x, WA_Top, y,
- WA_Width, w, WA_Height, h, /* Static items */
- WA_AutoAdjust, 1, WA_NewLookMenus, 1,
- WA_IDCMP, IDCMP_CLOSEWINDOW | IDCMP_RAWKEY |
- IDCMP_MOUSEBUTTONS| IDCMP_NEWSIZE |
- IDCMP_MENUPICK | IDCMP_MENUHELP,
- WA_PubScreen, new_screen,
- #if 0 /* CHFIXME: debugging aid */
- WA_BackFill, &background_hook,
- #endif
- WA_MenuHelp, 1, WA_Activate, 1,
- WA_SimpleRefresh, 1,
- WA_MaxWidth, -1, WA_MaxHeight, -1,
- WA_Backdrop, backdrop, /* changing items */
- WA_Borderless, backdrop,
- WA_CloseGadget, no_backdrop,
- WA_SizeGadget, no_backdrop,
- WA_DragBar, no_backdrop,
- WA_DepthGadget, no_backdrop,
- WA_Title, no_backdrop ?
- "GNU Emacs 19.25, Amiga port "VERS : 0,
- TAG_END, 0);
-
- UnlockPubScreen(0L, new_screen);
-
- if (new_win)
- {
- /* if emacs_backdrop then the screen title will show BEHIND the window
- -ch3/16/93. */
- ShowTitle(new_screen, !emacs_backdrop);
- SetFont(new_win->RPort, font);
-
- if (set_min_size(new_win, font, &minw, &minh) &&
- (new_console = (struct IOStdReq *)
- _device_open("console.device", CONU_CHARMAP, CONFLAG_NODRAW_ON_NEWSIZE,
- (APTR)new_win, sizeof(*new_win),
- sizeof(struct IOStdReq))))
- {
- inputsig |= 1L << new_win->UserPort->mp_SigBit;
- ConsoleDevice = (struct Library *)new_console->io_Device;
- #if 0 /* CHFIXME */
- emacs_app_win = AddAppWindowA(0, 0, new_win, wbport, 0);
- #endif
- /* Copy the info into permanent storage */
- EMACS_WIN(f) = new_win;
- emacs_console = new_console;
-
- /* fetch the name of the current screen -ch3/19/93 */
- emacs_screen_name = get_screen_name(EMACS_WIN(f)->WScreen,
- emacs_screen_name_storage);
-
- emacs_backdrop = backdrop;
-
- reset_window(f);
-
- return ok;
- }
- CloseWindow(new_win);
- }
- return no_window;
- }
-
- void force_window(FRAME_PTR f)
- {
- if (!EMACS_WIN(f) && !emacs_iconified)
- {
- if (open_emacs_window(f, emacs_x, emacs_y, emacs_w, emacs_h, emacs_backdrop,
- emacs_screen_name) != ok)
- {
- /* Try to return to defaults (Workbench, etc) */
- if (open_emacs_window(f, 0, 0, 640, 200, 0, 0) != ok)
- _fail("I've lost my window ! Exiting.");
- }
- resume_menus(f);
- }
- }
-
-
- #define X_left 0xff51
- #define X_up 0xff52
- #define X_right 0xff53
- #define X_down 0xff54
- #define X_help 0xff6a /* X11 code of the help key */
- #define X_f1 0xffbe /* X11 code of f1 (f2, ..., f35 follow) */
-
- /* returns:
- * -2 if msg is not class RAWKEY
- * same as RawKeyConvert otherwise:
- * buffer length if <= kbsize
- * -1 else
- *
- * fkeyflags[x] will be set to a function key if any
- * the decoding is done ala x (see keyboard.c)
- */
- static DeadKeyConvert(struct IntuiMessage *msg, UBYTE *kbuffer, USHORT *fkeyflags,
- int kbsize,
- struct KeyMap *kmap)
- {
- static struct InputEvent ievent = {0, IECLASS_RAWKEY, 0, 0, 0};
- int extra = 0, res;
-
- if (msg->Class != RAWKEY)
- {
- #if 0
- fprintf(stderr,"msg->Class = %d\n", (int) msg->Class);
- #endif
- return (-2);
- }
-
- /* Do some keymapping ourselves to make emacs users happy */
-
- switch(msg->Code)
- {
- case 0x40:
- /* Ctrl-space becomes Ctrl-@ */
- if (msg->Qualifier & CONTROL_MASK)
- {
- *kbuffer = 0;
- *fkeyflags = 0;
- return 1;
- }
- break;
- case 0x41:
- /* Backspace becomes DEL */
- if (amiga_remap_bsdel)
- {
- *kbuffer = 0177;
- *fkeyflags = 0;
- return 1;
- }
- break;
- case 0x46:
- /* And DEL becomes CTRL-D */
- if (amiga_remap_bsdel)
- {
- *kbuffer = 04;
- *fkeyflags = 0;
- return 1;
- }
- break;
- case 0x4C: /* Up arrow */
- *kbuffer = 0;
- *fkeyflags = X_up;
- return 1;
- case 0x4D: /* Down arrow */
- *kbuffer = 0;
- *fkeyflags = X_down;
- return 1;
- case 0x4E: /* Forward arrow */
- *kbuffer = 0;
- *fkeyflags = X_right;
- return 1;
- case 0x4F: /* Backward arrow */
- *kbuffer = 0;
- *fkeyflags = X_left;
- return 1;
- case 0x50:
- case 0x51:
- case 0x52:
- case 0x53:
- case 0x54:
- case 0x55:
- case 0x56:
- case 0x57:
- case 0x58:
- case 0x59:
- /* Map function keys to X equivalent */
- *kbuffer = 0;
- *fkeyflags = msg->Code - 0x50 + X_f1;
- return 1;
- case 0x5F:
- /* Map help key */
- *kbuffer = 0;
- *fkeyflags = X_help;
- return 1;
- default:
- break;
- }
- /* CHFIXME: may be replaced with kp-XXX symbols */
- /* Stick numeric pad prefix in front of numeric keypad chars */
- if (msg->Qualifier & IEQUALIFIER_NUMERICPAD && amiga_remap_numeric_keypad)
- {
- *kbuffer++ = 'x' & 037;
- *fkeyflags++=0;
- *kbuffer++ = '^' & 037;
- *fkeyflags++=0;
- *kbuffer++ = 'K';
- *fkeyflags++=0;
- kbsize -= 3;
- extra = 3;
- }
-
- /* pack input event */
- ievent.ie_Code = msg->Code;
-
- /* Ignore meta in decoding keys when not snapping */
- /* CHFIXME: if() needed below, too? */
- if(msg->Qualifier & NO_SNAP_MASK)
- ievent.ie_Qualifier = msg->Qualifier & ~META_MASK;
- else
- ievent.ie_Qualifier = msg->Qualifier;
-
- /* get previous codes from location pointed to by IAddress
- * this pointer is valid until IntuiMessage is replied.
- */
- ievent.ie_position.ie_addr = *((APTR *)msg->IAddress);
- ievent.ie_position.ie_dead.ie_prev1DownQual &= ~META_MASK;
- ievent.ie_position.ie_dead.ie_prev2DownQual &= ~META_MASK;
-
- res = RawKeyConvert(&ievent, kbuffer, kbsize, kmap);
- if(res > 0)
- {
- int i;
-
- for(i = 0; i < res; i++)
- *fkeyflags++ = 0;
- }
- return res ? res + extra : 0;
- }
-
- void add_wbevent(struct WBArg *wbarg)
- {
- char filename[256];
-
- if (wbarg->wa_Lock && NameFromLock(wbarg->wa_Lock, filename, 256))
- {
- struct wbevent *event;
-
- if (wbarg->wa_Name) AddPart(filename, wbarg->wa_Name, 256);
- if (event = (struct wbevent *)malloc(offsetof(struct wbevent, file) +
- strlen(filename) + 1))
- {
- event->next = wbevents;
- strcpy(event->file, filename);
- wbevents = event;
- }
- }
- }
-
- void get_mouse_char_pos(FRAME_PTR f, int *last_x, int *last_y)
- {
- int x, y;
-
- if(EMACS_WIN(f))
- {
- x = EMACS_WIN(f) -> MouseX;
- y = EMACS_WIN(f) -> MouseY;
- if((x < 0) ||
- (x > EMACS_WIN(f)->Width) ||
- (y < 0) ||
- (y > EMACS_WIN(f)->Height))
- {
- x = -1;
- y = -1;
- }
- else
- {
- x = amiga_pos_x(f,x);
- y = amiga_pos_y(f,y);
- }
- *last_x = x;
- *last_y = y;
- }
- else
- {
- *last_x = -1;
- *last_y = -1;
- }
- }
-
- void check_window(FRAME_PTR f, int force)
- {
- #ifdef TRY_NEW_MOUSE
- struct input_event event;
- struct timeval tv;
- #endif
- ULONG class;
- USHORT code, qualifier;
- UWORD mx, my;
- unsigned char buf[32];
- /* fkey will be set to a value != 0 if a function key event should be created */
- /* fkey needs to hold X key symbols 0xffXX */
- USHORT fkey[32];
- int buflen, deiconify, i;
- struct IntuiMessage *msg;
- int mouse_event = FALSE, wb_event = FALSE;
- struct AppMessage *amsg;
-
- force_window(f);
-
- if (EMACS_WIN(f))
- while (msg = (struct IntuiMessage *)GetMsg(EMACS_WIN(f)->UserPort))
- {
- class = msg->Class;
- code = msg->Code;
- qualifier = msg->Qualifier;
- mx = msg->MouseX; my = msg->MouseY;
- buflen = DeadKeyConvert(msg, buf, fkey, 32, 0);
- ReplyMsg(msg);
- #if 0
- fprintf(stderr,"class: 0x%08lx, code: 0x%08lx, qual: 0x%04x\n",
- (int) class,
- (int) code,
- (int) qualifier);
- #endif
- switch (class)
- {
- case IDCMP_CLOSEWINDOW: {
- enque(030, FALSE, FALSE); enque(03, FALSE, FALSE); /* ^X^C */ /* CHFIXME: map to delete_window */
- break;
- }
- case IDCMP_RAWKEY: {
- if (buflen > 0)
- {
- unsigned char *sbuf = buf;
- USHORT *sfkey = fkey;
- int meta = (qualifier & META_MASK) && (qualifier & NO_SNAP_MASK);
- int qual = (qualifier & SHIFT_MASK) ? shift_modifier : 0 +
- (qualifier & CONTROL_MASK) ? ctrl_modifier : 0 +
- (meta) ? meta_modifier : 0;
-
- do
- if(*sfkey)
- {
- /* provide full emacs qualifier mask for function keys */
- enque(*sfkey++, qual, 1);
- sbuf++;
- }
- else
- {
- /* Don't set META on CSI */
- enque(*sbuf++, meta, 0);
- sfkey++;
- }
- while (--buflen);
- }
- break;
- }
- case IDCMP_NEWSIZE:
- amiga_change_size(f);
- set_mouse_event_pending(); /* signal "input available" to get display redrawn */
- break;
- case IDCMP_MENUHELP:
- break; /* CHFIXME */
- case IDCMP_MENUPICK:
- if (code == MENUNULL) break;
- {
- int i;
- Lisp_Object prefixes[3];
- int menu_num = MENUNUM(code);
- int item_num = ITEMNUM(code);
- int subitem_num = SUBNUM(code);
-
- if((menu_num != NOMENU)
- && (item_num != NOITEM)
- && map_menu_selection(menu_num, item_num, subitem_num, prefixes))
- {
-
- event.kind = menu_bar_event;
- event.code = 0;
- event.modifiers = 0;
- event.x = 0;
- event.y = 0;
- event.frame_or_window = Qmenu_bar;
- gettimeofday (&tv, NULL);
- event.timestamp = tv.tv_usec;
- kbd_buffer_store_event (&event);
- for(i = 0; i < 3; i++)
- {
- if(NILP(prefixes[i]))
- break;
- /* CHFIXME: rethink validness of these values! */
- event.frame_or_window = prefixes[i];
- gettimeofday (&tv, NULL);
- event.timestamp = tv.tv_usec;
- kbd_buffer_store_event (&event);
- }
- set_mouse_event_pending(); /* get emacs to read the input queue */
- }
-
- }
- break; /* CHFIXME: add menu code */
- case IDCMP_MOUSEBUTTONS: {
- #ifdef TRY_NEW_MOUSE
- int but, down;
- switch(code)
- {
- case SELECTDOWN: but = 0; down = 1; break;
- case SELECTUP: but = 0; down = 0; break;
- case MIDDLEDOWN: but = 1; down = 1; break;
- case MIDDLEUP: but = 1; down = 0; break;
- case MENUDOWN: but = 2; down = 1; break;
- case MENUUP: but = 2; down = 0; break;
- default: but = -1; break;
- }
- #if 0
- fprintf(stderr,"Mouse: button %d, down = %d\n", but, down);
- #endif
- if(but >= 0)
- {
- event.kind = mouse_click;
- event.code = but;
- event.modifiers = ((qualifier & META_MASK) ? meta_modifier : 0)
- + ((qualifier & SHIFT_MASK) ? shift_modifier : 0)
- + ((qualifier & CONTROL_MASK) ? ctrl_modifier : 0)
- + (down ? down_modifier : up_modifier);
- #if 1/* keyboard.c uses pixel_to_glyph, so we need original pos */
- event.x = mx;
- event.y = my;
- #else
- event.x = amiga_pos_x(mx);
- event.y = amiga_pos_y(my);
- #endif
- event.frame_or_window = selected_frame;
- gettimeofday (&tv, NULL);
- event.timestamp = tv.tv_usec;
- kbd_buffer_store_event (&event);
- set_mouse_event_pending();
- }
- #else
- mouse_event = TRUE;
- if (event_num == EVENTSIZE) break;
-
- events[event_in].class = class;
- events[event_in].code = code;
- events[event_in].qual = qualifier;
- events[event_in].x = mx;
- events[event_in].y = my;
- event_num++;
- event_in = (event_in + 1) % EVENTSIZE;
- #endif
- break;
- }
- }
- }
- /* Handle App requests */
- while (amsg = (struct AppMessage *)GetMsg(wbport))
- switch (amsg->am_Type)
- {
- case AMTYPE_APPICON: case AMTYPE_APPWINDOW:
- /* Add an event for all these files */
- for (i = 0; i < amsg->am_NumArgs; i++) add_wbevent(amsg->am_ArgList + i);
- wb_event = TRUE;
- /* Reply to the message, and deiconify if was icon */
- deiconify = amsg->am_Type == AMTYPE_APPICON;
- ReplyMsg(amsg);
- if (deiconify && emacs_icon)
- /* Reopen window */
- if (open_emacs_window(f, emacs_x, emacs_y, emacs_w, emacs_h, emacs_backdrop,
- emacs_screen_name) == ok)
- {
- resume_menus(f);
- RemoveAppIcon(emacs_icon);
- emacs_icon = 0;
- emacs_iconified = 0;
- }
- break;
- default: ReplyMsg(amsg); break;
- }
-
- if (amiga_mouse_initialized && (force && event_num > 0 || mouse_event))
- {
- enque(AMIGASEQ, FALSE, FALSE); enque('M', FALSE, FALSE);
- }
- if (amiga_wb_initialized && (force && wbevents || wb_event))
- {
- enque(AMIGASEQ, FALSE, FALSE); enque('W', FALSE, FALSE);
- }
- }
-
- void setup_intchar(char intchar)
- {
- char cqbuf[2];
-
- if (MapANSI(&intchar, 1, cqbuf, 1, 0) == 1)
- {
- intkey_code = cqbuf[0];
- intkey_qualifier = cqbuf[1];
- }
- else
- {
- /* Default is CTRL-G in usa0 keymap */
- intkey_code = 0x24;
- intkey_qualifier = IEQUALIFIER_CONTROL;
- }
- }
-
- /* Hack to detect interrupt char as soon as it is pressed */
- /* __interrupt disables stack checking. -ch3/19/93.*/
- static long __saveds __interrupt __asm
- int_handler(register __a0 struct InputEvent *ev)
- {
- struct InputEvent *ep, *laste;
- static struct InputEvent retkey;
- ULONG lock = LockIBase(0);
- #ifndef MULTI_FRAME
- FRAME_PTR f;
- #else
- you lose, make loop of frames?
- #endif
-
- if (EMACS_WIN(f) && IntuitionBase->ActiveWindow == EMACS_WIN(f))
- {
- laste = 0;
-
- /* run down the list of events to see if they pressed the magic key */
- for (ep = ev; ep; laste = ep, ep = ep->ie_NextEvent)
- if (ep->ie_Class == IECLASS_RAWKEY &&
- (ep->ie_Qualifier & 0xff) == intkey_qualifier &&
- ep->ie_Code == intkey_code)
- {
- /* Remove this key from input sequence */
- if (laste) laste->ie_NextEvent = ep->ie_NextEvent;
- else ev = ep->ie_NextEvent;
-
- Vquit_flag = Qt;
- Signal(_us, SIGBREAKF_CTRL_C);
- }
- }
- UnlockIBase(lock);
-
- /* pass on the pointer to the event */
- return (long)ev;
- }
-
- #if 0
- DEFUN ("amiga-mouse-events", Famiga_mouse_events, Samiga_mouse_events, 0, 0, 0,
- "Return number of pending mouse events from Intuition.")
- ()
- {
- register Lisp_Object tem;
-
- check_intuition ();
-
- XSET (tem, Lisp_Int, event_num);
-
- return tem;
- }
-
- DEFUN ("amiga-proc-mouse-event", Famiga_proc_mouse_event, Samiga_proc_mouse_event,
- 0, 0, 0,
- "Pulls a mouse event out of the mouse event buffer and dispatches\n\
- the appropriate function to act upon this event.")
- ()
- {
- register Lisp_Object mouse_cmd;
- register char com_letter;
- register char key_mask;
- register Lisp_Object tempx;
- register Lisp_Object tempy;
- extern Lisp_Object get_keyelt ();
- extern int meta_prefix_char;
- struct event *ev;
- int posx, posy;
-
- check_intuition ();
-
- if (event_num) {
- ev = &events[event_out];
- event_out = (event_out + 1) % EVENTSIZE;
- event_num--;
- if (ev->class == MOUSEBUTTONS)
- {
- switch (ev->code)
- {
- case SELECTDOWN: com_letter = 2; break;
- case SELECTUP: com_letter = 6; break;
- case MIDDLEDOWN: com_letter = 1; break;
- case MIDDLEUP: com_letter = 5; break;
- case MENUDOWN: com_letter = 0; break;
- case MENUUP: com_letter = 4; break;
- default: com_letter = 3; break;
- }
- posx = amiga_pos_x(f,ev->x);
- posy = amiga_pos_y(f,ev->y);
- XSET (tempx, Lisp_Int, min (FRAME_WIDTH (selected_frame)-1, max (0, posx)));
- XSET (tempy, Lisp_Int, min (FRAME_HEIGHT (selected_frame)-1, max (0, posy)));
- }
- else
- {
- /* Must be Menu Pick or Help */
- com_letter = ev->class == IDCMP_MENUPICK ? 3 : 7;
-
- /* The parameters passed describe the selected item */
- XSET (tempx, Lisp_Int, MENUNUM(ev->code));
- XSET (tempy, Lisp_Int, ITEMNUM(ev->code));
- }
- if (ev->qual & META_MASK) com_letter |= 0x20;
- if (ev->qual & SHIFT_MASK) com_letter |= 0x10;
- if (ev->qual & CONTROL_MASK) com_letter |= 0x40;
-
- Vamiga_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
- Vamiga_mouse_item = make_number (com_letter);
- #if 0 /* CHFIXME */
- mouse_cmd = get_keyelt (access_keymap (MouseMap, com_letter));
- if (NILP (mouse_cmd)) {
- bitch_at_user ();
- Vamiga_mouse_pos = Qnil;
- }
- else return call1 (mouse_cmd, Vamiga_mouse_pos);
- #else
- return Qnil;
- #endif
- }
- return Qnil;
- }
-
- DEFUN ("amiga-get-mouse-event", Famiga_get_mouse_event, Samiga_get_mouse_event,
- 1, 1, 0,
- "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\
- ARG non-nil means return nil immediately if no pending event;\n\
- otherwise, wait for an event.")
- (arg)
- Lisp_Object arg;
- {
- register char com_letter;
- register char key_mask;
-
- register Lisp_Object tempx;
- register Lisp_Object tempy;
- struct event *ev;
- int posx, posy;
-
- check_intuition ();
-
- if (NILP (arg))
- {
- amiga_consume_input();
- while (!event_num)
- {
- int rfds = 1;
-
- select(1, &rfds, 0, 0, 0);
- amiga_consume_input();
- }
- }
- /*** ??? Surely you don't mean to busy wait??? */
-
- if (event_num) {
- ev = &events[event_out];
- event_out = (event_out + 1) % EVENTSIZE;
- event_num--;
- switch (ev->code)
- {
- case SELECTDOWN: com_letter = 2; break;
- case SELECTUP: com_letter = 6; break;
- case MIDDLEDOWN: com_letter = 1; break;
- case MIDDLEUP: com_letter = 5; break;
- case MENUDOWN: com_letter = 0; break;
- case MENUUP: com_letter = 4; break;
- default: com_letter = 3; break;
- }
- if (ev->qual & META_MASK) com_letter |= 0x20;
- if (ev->qual & SHIFT_MASK) com_letter |= 0x10;
- if (ev->qual & CONTROL_MASK) com_letter |= 0x40;
-
- posx = amiga_pos_x(f,ev->x);
- posy = amiga_pos_y(f,ev->y);
- XSET (tempx, Lisp_Int, min (FRAME_WIDTH (selected_frame)-1, max (0, posx)));
- XSET (tempy, Lisp_Int, min (FRAME_HEIGHT (selected_frame)-1, max (0, posy)));
-
- Vamiga_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
- Vamiga_mouse_item = make_number (com_letter);
- return Fcons (com_letter, Fcons (Vamiga_mouse_pos, Qnil));
- }
- return Qnil;
- }
- #endif
-
- DEFUN ("amiga-get-wb-event", Famiga_get_wb_event, Samiga_get_wb_event,
- 1, 1, 0,
- "Get next Workbench event out of workbench event buffer (a file name).\n\
- ARG non-nil means return nil immediately if no pending event;\n\
- otherwise, wait for an event.")
- (arg)
- Lisp_Object arg;
- {
- Lisp_Object file;
- struct wbevent *ev;
-
- check_intuition ();
-
- if (NILP (arg))
- {
- amiga_consume_input();
- while (!wbevents)
- {
- int rfds = 1;
-
- select(1, &rfds, 0, 0, 0);
- amiga_consume_input();
- }
- }
- /*** ??? Surely you don't mean to busy wait??? */
-
- if (wbevents) {
- file = build_string(wbevents->file);
- ev = wbevents;
- wbevents = wbevents->next;
- free(ev);
- return file;
- }
- return Qnil;
- }
-
- DEFUN("amiga-set-foreground-color", Famiga_set_foreground_color,
- Samiga_set_foreground_color, 1, 1, "nPen number: ",
- "Use PEN as foreground color")
- (pen)
- {
- int fg;
-
- check_intuition();
- CHECK_NUMBER(pen, 0);
-
- fg = XUINT (pen);
- if (pen > 7) error("Pen colors must be between 0 & 7");
- foreground = fg;
- reset_window(selected_frame);
- return Qnil;
- }
-
- DEFUN("amiga-set-background-color", Famiga_set_background_color,
- Samiga_set_background_color, 1, 1, "nPen number: ",
- "Use PEN as background color")
- (pen)
- {
- int bg;
-
- check_intuition();
- CHECK_NUMBER(pen, 0);
-
- bg = XUINT (pen);
- if (pen > 7) error("Pen colors must be between 0 & 7");
- background = bg;
- reset_window(selected_frame);
- return Qnil;
- }
-
- DEFUN("amiga-set-inverse-fill-pen", Famiga_set_inverse_fill_pen,
- Samiga_set_inverse_fill_pen, 1, 1, "nPen number: ",
- "Use PEN's color for inverse fills (0-7 or 8 for reverse)")
- (pen)
- {
- int ifp = 8;
-
- check_intuition();
- CHECK_NUMBER(pen, 0);
-
- ifp = XUINT (pen);
- if (pen > 8)
- error("choices are from 0 to 8");
- inverse_fill_pen = ifp;
- reset_window(selected_frame);
- return Qnil;
- }
-
- DEFUN("amiga-set-inverse-text-pen", Famiga_set_inverse_text_pen,
- Samiga_set_inverse_text_pen, 1, 1, "nPen number: ",
- "Use PEN's color for inverse fills (0-7 or 8 for reverse)")
- (pen)
- {
- int itp = 8;
-
- check_intuition();
- CHECK_NUMBER(pen, 0);
-
- itp = XUINT (pen);
- if (pen > 8)
- error("choices are from 0 to 8");
- inverse_text_pen = itp;
- reset_window(selected_frame);
- return Qnil;
- }
-
- DEFUN("amiga-set-font", Famiga_set_font, Samiga_set_font, 2, 2,
- "sFont: \n\
- nSize: ",
- "Set font used for window to FONT with given HEIGHT.\n\
- The font used must be non-proportional.")
- (wfont, height)
- {
- struct TextAttr attr;
- struct TextFont *newfont;
- char *fname;
- struct Lisp_String *fstr;
- WORD minw, minh, oldmw, oldmh;
- FRAME_PTR f = selected_frame; /* CHFIXME? */
-
- CHECK_STRING (wfont, 0);
- CHECK_NUMBER (height, 0);
-
- check_intuition();
-
- fstr = XSTRING (wfont);
- fname = (char *)alloca (fstr->size + 6);
- strcpy (fname, fstr->data);
- strcat (fname, ".font");
- attr.ta_Name = fname;
- attr.ta_YSize = XFASTINT (height);
- attr.ta_Style = 0;
- attr.ta_Flags = 0;
- newfont = OpenDiskFont (&attr);
-
- if (!newfont)
- error ("Font %s %d not found", fstr->data, XFASTINT (height));
- if (newfont->tf_Flags & FPF_PROPORTIONAL)
- {
- CloseFont(newfont);
- error ("Font %s %d is proportional", fstr->data, XFASTINT (height));
- }
-
- if (EMACS_WIN(f))
- {
- if (!set_min_size(EMACS_WIN(f), newfont, &minw, &minh))
- {
- CloseFont(newfont);
- if (!set_min_size(EMACS_WIN(f), font, &oldmw, &oldmh))
- _fail("Failed to restore old font, exiting.");
- error("Window is too small for this font, need at least %d(w) by %d(h)",
- minw, minh);
- }
- SetFont(EMACS_WIN(f)->RPort, newfont);
- }
- if (font_opened) CloseFont(font);
- font_opened = TRUE;
- font = newfont;
- reset_window(f);
- return Qnil;
- }
-
- DEFUN("amiga-set-geometry", Famiga_set_geometry, Samiga_set_geometry, 4, MANY, 0,
- "Set Emacs window geometry and screen.\n\
- First 4 parameters are the (X,Y) position of the top-left corner of the window\n\
- and its WIDTH and HEIGHT. These must be big enough for an 11x4 characters window.\n\
- If nil is given for any of these, that means to keep the same value as before.\n\
- The optional argument SCREEN specifies which screen to use, nil stands for the\n\
- same screen as the window is on, t stands for the default public screen (normally\n\
- the Workbench), a string specifies a given public screen.\n\
- If optional argument BACKDROP is t, a backdrop window is used.")
- (nargs, args)
- int nargs;
- Lisp_Object *args;
- {
- Lisp_Object x, y, w, h, scr = Qnil, backdrop = Qnil;
- int opened;
- WORD tempx, tempy, tempw, temph;
- char *screen_name;
- int use_backdrop;
- FRAME_PTR f = selected_frame; /* CHFIXME */
-
- if (nargs > 6) error("Too many arguments to amiga-set-geometry");
- x = args[0]; y = args[1]; w = args[2]; h = args[3];
- if (nargs > 4)
- {
- scr = args[4];
- if (nargs > 5) backdrop = args[5];
- }
-
- check_intuition();
-
- if (!NILP (x))
- {
- CHECK_NUMBER(x, 0);
- tempx = XUINT(x);
- }
- else tempx = EMACS_X();
- if (!NILP (y))
- {
- CHECK_NUMBER(y, 0);
- tempy = XUINT(y);
- }
- else tempy = EMACS_Y();
- if (!NILP (w))
- {
- CHECK_NUMBER(w, 0);
- tempw = XUINT(w);
- }
- else tempw = EMACS_W();
- if (!NILP (h))
- {
- CHECK_NUMBER(h, 0);
- temph = XUINT(h);
- }
- else temph = EMACS_H();
-
- use_backdrop = !NILP(backdrop);
-
- if (scr == Qt) screen_name = 0; /* set to zero for def. */
- else if (!NILP (scr))
- {
- CHECK_STRING (scr, 0);
- screen_name = XSTRING (scr)->data;
- }
- else screen_name = emacs_screen_name;
-
- if (EMACS_WIN(f))
- {
- struct Window *old_win = EMACS_WIN(f);
- struct IOStdReq *old_console = emacs_console;
-
- suspend_menus(f);
- opened = open_emacs_window(f, tempx, tempy, tempw, temph, use_backdrop,
- screen_name);
- if (opened != ok)
- {
- resume_menus(f);
-
- if (opened == no_window) error("Failed to open desired window");
- else if (screen_name)
- error("Unknown public screen %s", screen_name);
- else error("The default screen wasn't found !?");
- }
-
- _device_close(old_console);
- CloseWindow(old_win);
- if (!resume_menus(f)) error("Failed to recover menus (No memory?)");
- }
- else /* No window, set defaults */
- {
- emacs_screen_name = screen_name;
- if (screen_name)
- {
- emacs_screen_name_storage[MAXPUBSCREENNAME] = '\0';
- strncpy(emacs_screen_name_storage, screen_name, MAXPUBSCREENNAME);
- }
- emacs_x = tempx;
- emacs_y = tempy;
- emacs_w = tempw;
- emacs_h = temph;
- emacs_backdrop = use_backdrop;
- }
- return Qnil;
- }
-
-
- /* The next 2 functions are very usefull for writing
- * arexx/lisp functions that interact with other programs
- * that will be sharing the same screen. -ch3/19/93. */
-
- DEFUN("amiga-get-window-geometry",
- Famiga_get_window_geometry, Samiga_get_window_geometry, 0, 0, 0,
- "Get Emacs window geometry.\n\
- a list returned is of the form: (iconified x y width height backdrop)\n\
- where x, y, width, height are integers, backdrop is t or nil and iconified\n\
- is t if the window is iconified and nil otherwise")
- ()
- {
- Lisp_Object x, y, w, h, b, i;
-
- XSET(x, Lisp_Int, EMACS_X());
- XSET(y, Lisp_Int, EMACS_Y());
- XSET(w, Lisp_Int, EMACS_W());
- XSET(h, Lisp_Int, EMACS_H());
- b = emacs_backdrop ? Qt : Qnil;
- i = emacs_iconified ? Qt : Qnil;
-
- return Fcons(i, Fcons(x, Fcons(y, Fcons(w, Fcons(h, Fcons(b, Qnil))))));
- }
-
- DEFUN("amiga-get-screen-geometry",
- Famiga_get_screen_geometry, Samiga_get_screen_geometry, 0, 0, 0,
- "Get geometry of the screen emacs window resides on.\n\
- a list returned is of the form: (name x y width height)\n\
- where name is a string, x, y, width, height are integers.\n\
- Only the public screen name is returned if the window is not currently open.\n\
- In this last case, the name may be nil if the window will be opened on the\n\
- default public screen.")
- ()
- {
- Lisp_Object name;
-
- if (emacs_screen_name) name = Qnil;
- else name = build_string(emacs_screen_name);
-
- if(EMACS_WIN(f))
- {
- struct Screen *s = EMACS_WIN(f)->WScreen;
- Lisp_Object x, y, w, h;
-
- XSET(x, Lisp_Int, s->LeftEdge);
- XSET(y, Lisp_Int, s->TopEdge);
- XSET(w, Lisp_Int, s->Width);
- XSET(h, Lisp_Int, s->Height);
-
- return Fcons(name, Fcons(x, Fcons(y, Fcons(w, Fcons(h, Qnil)))));
- }
- return Fcons(name, Qnil);
- }
-
- DEFUN("amiga-iconify", Famiga_iconify, Samiga_iconify, 0, 0, "",
- "Toggle the emacs iconification state.")
- ()
- {
- FRAME_PTR f = selected_frame; /* CHFIXME */
-
- check_intuition();
-
- if (emacs_iconified)
- {
- /* Deiconify */
-
- /* Reopen window */
- if (open_emacs_window(f, emacs_x, emacs_y, emacs_w, emacs_h, emacs_backdrop,
- emacs_screen_name) != ok)
- error("Failed to deiconify (No memory?)");
- resume_menus(f);
-
- RemoveAppIcon(emacs_icon);
- emacs_icon = 0;
- emacs_iconified = 0;
- }
- else
- if (emacs_icon = AddAppIconA(0, 0, "Emacs", wbport, 0, &emacs_icon_object, 0))
- {
- if (EMACS_WIN(f))
- {
- /* Close window */
- emacs_x = EMACS_X(); emacs_y = EMACS_Y();
- emacs_w = EMACS_W(); emacs_h = EMACS_H();
- suspend_menus(f);
- close_emacs_window(f);
- }
- emacs_iconified = 1;
- }
- else error("Iconify attempt failed\n");
-
- return Qnil;
- }
-
- DEFUN("amiga-set-icon-pos", Famiga_set_icon_pos, Samiga_set_icon_pos, 2, 2,
- "nX position: \n\
- nY position: ",
- "Set the X Y position of the icon for emacs when iconified.")
- (Lisp_Object x, Lisp_Object y)
- {
- long xpos, ypos;
-
- if (NILP (x)) emacs_icon_object.do_CurrentX = NO_ICON_POSITION;
- else
- {
- CHECK_NUMBER (x, 0);
- emacs_icon_object.do_CurrentX = XINT(x);
- }
- if (NILP (y)) emacs_icon_object.do_CurrentY = NO_ICON_POSITION;
- else
- {
- CHECK_NUMBER (y, 0);
- emacs_icon_object.do_CurrentY = XINT(y);
- }
-
- return Qnil;
- }
-
- struct EClockVal scount[16], ecount[16];
- long total[16], counting[16], nb[16], susp[16];
-
- void start_count(int n)
- {
- nb[n]++;
- if (counting[n]) printf("Restarted %d\n", n);
- counting[n] = 1;
- /*ReadEClock(&scount[n]);*/
- }
-
- void stop_count(int n)
- {
- if (counting[n])
- {
- /*ReadEClock(&ecount[n]);*/
- counting[n] = 0;
-
- total[n] += ecount[n].ev_lo - scount[n].ev_lo;
- }
- }
-
- void suspend_count(int n)
- {
- if (counting[n] && susp[n]++ == 0)
- {
- /*ReadEClock(&ecount[n]);*/
- total[n] += ecount[n].ev_lo - scount[n].ev_lo;
- }
- }
-
- void resume_count(int n)
- {
- if (counting[n] && --susp[n] == 0) /*ReadEClock(&scount[n])*/;
- }
-
- disp_counts(void)
- {
- int i;
-
- for (i = 0; i < 16; i++)
- {
- printf("%d(%d) ", total[i], nb[i]);
- total[i] = nb[i] = 0;
- }
- printf("\n");
- }
-
- void screen_puts(FRAME_PTR f, char *str, unsigned int len)
- {
- if (EMACS_WIN(f))
- {
- int i;
-
- emacs_console->io_Command = CMD_WRITE;
- emacs_console->io_Data = (APTR)str;
- emacs_console->io_Length = len;
-
- /* start_count(0);
- for (i = 1; i <= 6; i++) suspend_count(i);*/
- DoIO(emacs_console);
- /* for (i = 1; i <= 6; i++) resume_count(i);
- stop_count(0);*/
- }
- }
-
- DEFUN ("amiga-activate-window", Famiga_activate_window, Samiga_activate_window, 0, 0, 0,
- "Makes emacs window the currently active one.")
- ()
- {
- if(EMACS_WIN(f)) {
- ActivateWindow(EMACS_WIN(f));
- return Qnil;
- }
- error("No window to make active.");
- return Qnil;
- }
-
- void
- Aframe_raise_lower(FRAME_PTR f, int raise)
- {
- if(raise)
- {
- if(EMACS_WIN(f))
- WindowToFront(EMACS_WIN(f));
- }
- else
- {
- if(EMACS_WIN(f))
- WindowToBack(EMACS_WIN(f));
- }
- }
-
- DEFUN ("amiga-window-to-front", Famiga_window_to_front, Samiga_window_to_front, 0, 0, 0,
- "Pulls the emacs window to the front (including screen)")
- ()
- {
- if(EMACS_WIN(f)) {
- WindowToFront(EMACS_WIN(f));
- ScreenToFront(EMACS_WIN(f)->WScreen);
- return Qnil;
- }
- error("No window to pull to the front.");
- return Qnil;
- }
-
- DEFUN ("amiga-window-to-back", Famiga_window_to_back, Samiga_window_to_back, 0, 0, 0,
- "Pushes the emacs window to the back (including screen)")
- ()
- {
- if(EMACS_WIN(f)) {
- WindowToBack(EMACS_WIN(f));
- ScreenToBack(EMACS_WIN(f)->WScreen);
- return Qnil;
- }
- error("No window to push back.");
- return Qnil;
- }
-
- DEFUN ("amiga-popup-font-request", Famiga_popup_font_request, Samiga_popup_font_request, 0, 0, 0,
- "Open an ASL Font Requester and return the value as cons of font name and font size.")
- ()
- {
- LONG Top = 0, Left = 0;
- Lisp_Object RetVal = Qnil;
- struct FontRequester *Req;
-
- if(EMACS_WIN(f))
- {
- Top = EMACS_WIN(f)->TopEdge + EMACS_WIN(f)->MouseY - 75;
- Left = EMACS_WIN(f)->LeftEdge + EMACS_WIN(f)->MouseX - 160;
- AslBase = OpenLibrary("asl.library", 0);
- if(AslBase)
- {
- Req = AllocAslRequestTags(ASL_FontRequest,
- ASL_Hail, "Emacs Font Request",
- ASL_FuncFlags, FONF_FIXEDWIDTH,
- TAG_DONE);
- if(Req)
- {
- if(AslRequestTags(Req,
- ASL_TopEdge, Top,
- ASL_LeftEdge, Left,
- ASL_Height, 250, TAG_DONE))
- {
- char *s;
-
- s = strstr(Req->fo_Attr.ta_Name, ".font");
- if(s)
- RetVal = Fcons(make_string(Req->fo_Attr.ta_Name,
- s - Req->fo_Attr.ta_Name),
- make_number(Req->fo_Attr.ta_YSize));
- }
- FreeAslRequest(Req);
- }
- CloseLibrary(AslBase);
- }
- }
- return RetVal;
- }
-
- #ifdef USE_SCROLL_BARS
- /*
- * Lisp_ScrollBar is a Lisp_Vector
- */
- struct Lisp_ScrollBar
- {
- int size;
- struct Lisp_ScrollBar *next;
- Lisp_Object window;
- Lisp_Object
- };
-
- /* Arrange for all scroll bars on FRAME to be removed at the next call
- to `*judge_scroll_bars_hook'. A scroll bar may be spared if
- `*redeem_scroll_bar_hook' is applied to its window before the judgement.
-
- This should be applied to each frame each time its window tree is
- redisplayed, even if it is not displaying scroll bars at the moment;
- if the HAS_SCROLL_BARS flag has just been turned off, only calling
- this and the judge_scroll_bars_hook will get rid of them.
-
- If non-zero, this hook should be safe to apply to any frame,
- whether or not it can support scroll bars, and whether or not it is
- currently displaying them. */
-
- void
- Acondemn_scroll_bars(FRAME_PTR f)
- {
- FRAME_CONDEMNED_SCROLL_BARS(f) = FRAME_SCROLL_BARS(f);
- FRAME_SCROLL_BARS(f) = Qnil;
- }
-
- /* Unmark WINDOW's scroll bar for deletion in this judgement cycle.
- Note that it's okay to redeem a scroll bar that is not condemned. */
-
- void
- Aredeem_scroll_bar(struct window *w)
- {
- FRAME_PTR f = WINDOW_FRAME(w);
-
-
- }
-
- /* Remove all scroll bars on FRAME that haven't been saved since the
- last call to `*condemn_scroll_bars_hook'.
-
- This should be applied to each frame after each time its window
- tree is redisplayed, even if it is not displaying scroll bars at the
- moment; if the HAS_SCROLL_BARS flag has just been turned off, only
- calling this and condemn_scroll_bars_hook will get rid of them.
-
- If non-zero, this hook should be safe to apply to any frame,
- whether or not it can support scroll bars, and whether or not it is
- currently displaying them. */
- void Ajudge_scroll_bars(FRAME_PTR f)
- {
- }
- #endif /* USE_SCROLL_BARS */
-
- void syms_of_amiga_screen(void)
- {
- DEFVAR_LISP ("amiga-mouse-item", &Vamiga_mouse_item,
- "Encoded representation of last mouse click, corresponding to\n\
- numerical entries in amiga-mouse-map.");
- Vamiga_mouse_item = Qnil;
- DEFVAR_LISP ("amiga-mouse-pos", &Vamiga_mouse_pos,
- "Current x-y position of mouse by row, column as specified by font.");
- Vamiga_mouse_pos = Qnil;
-
- DEFVAR_BOOL ("amiga-remap-bsdel", &amiga_remap_bsdel,
- "*If true, map DEL to Ctrl-D and Backspace to DEL. \n\
- This is the most convenient (and default) setting. If nil, don't remap.");
- amiga_remap_bsdel = 1;
-
- DEFVAR_BOOL ("amiga-remap-numeric-keypad", &amiga_remap_numeric_keypad,
- "*If true, numeric keypad keys are prefixed with C-x C-^ K.\n\
- This enables you to remap them, but causes problems with functions like\n\
- isearch-forward-regexp on some keyboards. Default to true.");
- amiga_remap_numeric_keypad = 1;
-
- DEFVAR_BOOL ("amiga-mouse-initialized", &amiga_mouse_initialized,
- "Set to true once lisp has been setup to process mouse commands.\n\
- No mouse processing request (C-X C-^ M) will be queued while this is nil.");
- amiga_mouse_initialized = 0;
-
- DEFVAR_BOOL ("amiga-wb-initialized", &amiga_wb_initialized,
- "Set to true once lisp has been setup to process workbench commands.\n\
- No workbench processing request (C-X C-^ W) will be queued while this is nil.");
- amiga_mouse_initialized = 0;
-
- #if 0
- defsubr (&Samiga_mouse_events);
- defsubr (&Samiga_proc_mouse_event);
- defsubr (&Samiga_get_mouse_event);
- #endif
- defsubr (&Samiga_get_wb_event);
- defsubr (&Samiga_set_font);
- defsubr (&Samiga_set_geometry);
- defsubr (&Samiga_set_background_color);
- defsubr (&Samiga_set_foreground_color);
- defsubr (&Samiga_iconify);
- defsubr (&Samiga_set_icon_pos);
-
- /* New functions -ch3/19/93. */
- defsubr (&Samiga_set_inverse_text_pen);
- defsubr (&Samiga_set_inverse_fill_pen);
- defsubr (&Samiga_window_to_front);
- defsubr (&Samiga_window_to_back);
- defsubr (&Samiga_activate_window);
- defsubr (&Samiga_get_window_geometry);
- defsubr (&Samiga_get_screen_geometry);
-
- /* New functions -Alph08/24/94 */
- defsubr (&Samiga_popup_font_request);
- }
-
- void init_amiga_screen(void)
- {
- event_num = event_in = event_out = 0;
-
- if (!((IntuitionBase = (struct IntuitionBase *)
- OpenLibrary("intuition.library", 37L)) &&
- (GfxBase = (struct GfxBase *)OpenLibrary("graphics.library", 0L)) &&
- (DiskfontBase = OpenLibrary("diskfont.library", 0L)) &&
- (WorkbenchBase = OpenLibrary("workbench.library", 37)) &&
- (KeymapBase = OpenLibrary("keymap.library", 36)) &&
- (input_req = (struct IOStdReq *)_device_open("input.device", 0, 0, 0, 0,
- sizeof(struct IOStdReq)))))
- _fail("Need version 2.04 and diskfont.library!");
-
- if (!(wbport = CreateMsgPort())) no_memory();
-
- /* Add Ctrl-G detector */
- int_handler_hook.is_Data = 0;
- int_handler_hook.is_Code = (void *)int_handler;
- int_handler_hook.is_Node.ln_Pri = 100; /* 100 not 127 is the standard value
- * for input stream handlers. -ch3/19/93. */
- /* it is standard for interrupts to have names -ch3/19/93.*/
- int_handler_hook.is_Node.ln_Name = "GNU Emacs CTRL-G handler";
- input_req->io_Command = IND_ADDHANDLER;
- input_req->io_Data = (APTR)&int_handler_hook;
-
- /* wasn't checking for error. -ch3/19/93. */
- #if 1 /* CHFIXME make debugging life a bit more easy */
- hooked = FALSE;
- #else
- if(0 == DoIO(input_req))
- hooked = TRUE;
- else
- {
- hooked = FALSE;
- _fail("couldn't get input handler hook for CTRL-G");
- }
- #endif
- inputsig |= 1L << wbport->mp_SigBit;
-
- background_hook.h_Entry = (ULONG (*)()) fill_background; /* added cast. */
- font = GfxBase->DefaultFont;
-
- init_amiga_menu();
- }
-
- void cleanup_amiga_screen(void)
- {
- if (hooked)
- {
- input_req->io_Command = IND_REMHANDLER;
- input_req->io_Data = (APTR)&int_handler_hook;
- DoIO(input_req);
- }
- close_app_win();
- if (wbport) DeleteMsgPort(wbport);
- cleanup_amiga_menu();
- _device_close(emacs_console);
- #ifdef MULTI_FRAME
- you lose
- #endif
- if (EMACS_WIN(f)) CloseWindow(EMACS_WIN(f));
- if (font_opened) CloseFont(font);
- if (IntuitionBase) CloseLibrary(IntuitionBase);
- if (GfxBase) CloseLibrary(GfxBase);
- if (DiskfontBase) CloseLibrary(DiskfontBase);
- if (WorkbenchBase) CloseLibrary(WorkbenchBase);
- if (KeymapBase) CloseLibrary(KeymapBase);
- _device_close(input_req);
- }
-